home *** CD-ROM | disk | FTP | other *** search
/ Aminet 6 / Aminet 6 - June 1995.iso / Aminet / comm / bbs / crazy8s2.lha / 8s.bas next >
Encoding:
BASIC Source File  |  1994-11-23  |  37.8 KB  |  1,901 lines
  1. REM ******************************************************************
  2.  
  3. REM Program- Crazy 8s
  4. REM    Date- 5 June 1991
  5. REM  Author- Peter Deane
  6. REM
  7. REM Version- 2.0
  8. REM
  9. REM  (Recompiled 23 Nov 94 to run under OzMetro)
  10.  
  11. REM ******************************************************************
  12.  
  13. ON ERROR GOTO woops
  14. TIMER ON
  15. ON TIMER (60) GOSUB RtimeDec
  16.  
  17. ' Set things so you can DO things!
  18. CLEAR ,20000&
  19. CLEAR
  20. DEFLNG a-z
  21. DEFINT k
  22. cr$=CHR$(13)+CHR$(10)
  23. de$=CHR$(8)+" "+CHR$(8)
  24. null$=CHR$(0)
  25. esc$=CHR$(27)
  26. DIM Scores$(15,3)
  27.  
  28. TestIt$="notreallyno"
  29.  
  30. IF Testit$<>"YES" THEN
  31.   'read ram:userdata in
  32.   OPEN "I",#2,"RAM:USERDATA"
  33.   LINE INPUT#2,tpc$
  34.   LINE INPUT#2,uname$
  35.   LINE INPUT#2,id$
  36.   LINE INPUT#2,lev$
  37.   LINE INPUT#2,bd$
  38.   LINE INPUT#2,ring$
  39.   LINE INPUT#2,path$
  40.   CLOSE#2
  41. ELSE
  42.   'setup dummy variables
  43.   tpc$="250"
  44.   id$="999"
  45.   lev$="9"
  46.   ring$="0"
  47.   ring%=0
  48.   bd$="2400"
  49.   PRINT "Enter Your Name ";
  50.   in%=2:il%=25:GOSUB Modem.in
  51.   if in$="" THEN in$="NAMELESS SWINE"
  52.   uname$=in$
  53.   path$=""
  54. END IF
  55.  
  56.  
  57. 'convert to short integers
  58. rtime%=VAL(tpc$)
  59. id%=VAL(id$)
  60. lev%=VAL(lev$)
  61. ring%=VAL(ring$)
  62. Baud=VAL(bd$)
  63. Title$="Crazy 8's (by PD) - User # "+id$+" ["+uname$+"]  Lev: "+lev$
  64. IF ring%=1 THEN
  65.   title$=title$+" Baud: "+bd$
  66. ELSE
  67.   title$=title$+" Baud: Local Login"
  68. END IF
  69.  
  70.  
  71. 'open modem
  72. IF ring%=1 THEN
  73.   OPEN "COM1:"+bd$+",n,8,1" AS #1 LEN=4096
  74.   GOSUB delay1
  75.   GOSUB delay1
  76. END IF
  77.  
  78.  
  79. 'HouseKeeping
  80. timeon=TIMER
  81. RANDOMIZE TIMER
  82. LIBRARY "graphics.library"
  83. DECLARE FUNCTION SetSoftStyle LIBRARY
  84.  
  85.  
  86. 'get a local environment
  87. SCREEN 1,640,202,3,2
  88. COLOR 0,1
  89. WINDOW 1,title$,(0,2)-(631,188),0,1
  90. WINDOW OUTPUT 1
  91. PALETTE 0, 0!, 0!, 0!
  92. PALETTE 1, .93, .2,  0!
  93. PALETTE 2, .22, .87, 0!
  94. PALETTE 3, 1!, 1!, .31
  95. PALETTE 4, .1, .4, .8
  96. PALETTE 5, .8, 0!, .93
  97. PALETTE 6, 0!, .93, .93
  98. PALETTE 7, 1!,1!,.93
  99.  
  100.  
  101. 'First Words
  102. GOSUB ClearScreen
  103. MPrint cr$+"Welcome to the Crazy 8s Door"
  104. MPrint cr$+cr$+"(Version 2.0  - 23 November 1994)"
  105. MPrint cr$+cr$+cr$+"Original Author Unknown"
  106. MPrint cr$+cr$+"Converted to a Metro Door by Peter Deane"
  107. MPrint cr$+cr$+"Inquestor BBS, NSW, Australia."+cr$
  108. GOSUB TimeCheck
  109.  
  110.  
  111. ' Grab some items from the Metro.config
  112. ' flnm$="s:Metro.config"
  113. ' OPEN flnm$ FOR INPUT AS #2
  114. '   LINE INPUT #2, BBSName$
  115. '   LINE INPUT #2, garb$
  116. '   LINE INPUT #2, BBSPath$
  117. '   LINE INPUT #2, MAILPath$
  118. '   LINE INPUT #2, UDPath$
  119. '   FOR k=1 TO 19
  120. '     LINE INPUT #2, garb$
  121. '   NEXT
  122. '   LINE INPUT #2, SYSOPName$
  123. ' CLOSE #2
  124. ' BBSPath$=BBSPath$+"BBSFiles/"
  125. ' MAILPath$=MAILPath$+"Mailfiles/"
  126. ' UDPath$=UDPath$+"UDFiles/"
  127.  
  128.  
  129. 'set config variables
  130.  
  131. GOSUB SetAnsi 
  132. GOSUB Speakcheck
  133. GOSUB ClearScreen
  134. GOSUB About
  135.  
  136. REM    Eights       a card game      <- this is about the only orig rem
  137. '      ------        14-Jan-85          stmnt. I left it in for nostalgia!
  138.  
  139. DIM c(52)
  140. DIM acard$(26)
  141. DIM s$(32)
  142. DIM v(10)
  143. DIM p(10)
  144. DIM s(5)
  145.  
  146.  
  147. REM ******************************************************************
  148. TopMenu:
  149. REM ******************************************************************
  150.  
  151. GOSUB MenuPrint ' Print it up all the time now it's hot-keyed :-)
  152.                 ' The '?' is ridiculous - any key other than Q P I A S prints
  153.                 ' the menu, anyway! 
  154. GOSUB TimeCheck
  155. Mcol 36
  156. MPrint cr$+Time2$+"  "
  157. MCol 33
  158. MPrint " (Time Left:"+STR$(rtime%)+")"
  159. MCol 31
  160. MPrint "  Options: <P>-<I>-<A>-<S>-<Q> [?=Menu] "
  161. in%=0:il%=1
  162. GOSUB modem.in
  163.  
  164. CommandBranch:
  165. GOSUB TimeCheck
  166.  
  167. IF in$="Q" THEN GOTO FinishUp
  168. IF in$="P" THEN GOSUB PlaySection
  169. IF in$="I" THEN GOSUB Instruct
  170. IF in$="A" THEN GOSUB About
  171. IF in$="S" THEN GOSUB Scores
  172.  
  173. GOTO TopMenu
  174.  
  175.  
  176.  
  177. REM ******************************************************************
  178. PlaySection:
  179. REM ******************************************************************
  180.  
  181. 'Reset v array (ie scores)
  182.  
  183. FOR p1=1 TO 8
  184.   v(p1)=0 
  185. NEXT p1
  186. hndno=0
  187.  
  188. GOSUB ClearScreen
  189. MCol 37
  190. MPrint "       There are two sections of this game: Competition & Practice"+cr$
  191. MCol 35
  192. MPrint cr$+"       In the Comp Section, you must play 5 games straight against 3"
  193. MPrint cr$+"       opponents. But your results WILL be eligible to go into the"
  194. MPrint cr$+"       Best Scores Table."+cr$
  195. MCol 33
  196. MPrint cr$+"       The Practice Section allows you to play one game against any"
  197. MPrint cr$+"       number of opponents, but you will NOT be able to make it into"
  198. MPrint cr$+"       the Best Scores Table."+cr$
  199. MCol 31
  200. MPrint cr$+"       WARNING: If you QUIT at any time during the 5 Comp games, you "
  201. MPrint cr$+"       will NOT be eligible to make the Best Scores Table."+cr$
  202.  
  203. WhichGame:
  204. MCol 37
  205. MPrint cr$+cr$+"                <"
  206. MCol 31
  207. MPrint "P"
  208. MCol 37
  209. MPrint ">"
  210. MCol 32
  211. MPrint "ractice Section"
  212. MCol 37
  213. MPrint "    <"
  214. MCol 31
  215. MPrint "C"
  216. MCol 37
  217. MPrint ">"
  218. MCol 32
  219. MPrint "ompetition Section "+cr$
  220. in%=0:il%=1:GOSUB Modem.in
  221. IF in$<>"P" AND in$<>"C" THEN WhichGame
  222. GOSUB ClearScreen
  223.  
  224. IF in$="P" THEN
  225.   CompGame=0
  226.   MPrint "You have chosen to use the Practice Section"+cr$
  227.   NoPlayersCheck:
  228.   MCol 31
  229.   MPrint cr$+cr$+cr$+"Including you, how many players (2, 3 or 4) ? "
  230.   in%=0:il%=1:GOSUB modem.in
  231.   MPrint in$
  232.   k=VAL(in$)
  233.   IF k<2 OR k>4 THEN NoPlayersCheck:
  234.   N=k
  235.   GOSUB Main
  236.   RETURN
  237. ELSE
  238.   CompGame=1
  239.   MPrint "Starting the Competition Match. Good Luck!"+cr$+cr$
  240.   GOSUB Delay1
  241.  
  242.   N=4             'This is the # players .. see!  (not my code)
  243.  
  244.   GOSUB Main
  245.   IF QuitGameFlag=1 THEN    ' This Quit Game flag was needed - sorry.
  246.                             ' this is for the best scores table - 
  247.                             ' if they quit a game, they don't make it....
  248.     QuitGameFlag=0
  249.     RETURN                  ' <=---- See..
  250.   END IF
  251. END IF
  252.  
  253. GamesLoop:
  254.  
  255. IF hndno<5 THEN
  256.   GOSUB TimeCheck
  257.   MCol 33
  258.   MPrint cr$+cr$+"You have"+STR$(rtime%)+" minutes remaining."
  259.   MCol 35
  260.   Matt 3
  261.   MPrint cr$+cr$
  262.  
  263.   'Smart-Alec Comments Section
  264.   ' ... Working Storage Division....  
  265.   ' 01  INDEX   PIC 99.
  266.   ' 
  267.   ' hangon, this is BASIC, you fool!
  268.   '
  269.   Index=(6-HndNo)*v(1)
  270.  
  271.   IF Index<10              THEN MPrint "So, you think you're doing pretty well, eh, Bucko?"
  272.   IF Index<20 AND Index>9  THEN MPrint "Don't be so cocky, you still haven't played 5 games!"
  273.   IF Index<30 AND Index>19 THEN Mprint "The computer will always beat inferior humans. Beware!"
  274.   IF Index<40 AND Index>29 THEN MPrint "Average play from an average player. Zzzzzzzz!"
  275.   IF Index<50 AND Index>39 THEN MPrint "I suggest you read the instructions again!"
  276.   IF Index<60 AND Index>49 THEN MPrint "Say, would you like to borrow my spectacles?"
  277.   IF Index<70 AND Index>59 THEN MPrint "You don't stand an iceberg's chance in Hell of doing much good!"
  278.   IF Index >69             THEN MPrint "Huh! My grandmother plays better than you, and she can't see!"
  279.  
  280.   Matt 0
  281.   MCol 36
  282.   MPrint cr$+cr$+"Continue Competition Games (Y/n)? "
  283.   MCol 37
  284.   in%=3:il%=1:YES=1:GOSUB Modem.in
  285.   IF in$="NO" THEN
  286.     MCol 36
  287.     MPrint cr$+cr$+"Okay, but you aren't eligible to go into the"
  288.     MPrint cr$+"Best Scores Table for that woeful effort!"+cr$
  289.     GOSUB AnyKey
  290.     RETURN
  291.   END IF
  292.   GOSUB Main
  293.   IF QuitGameFlag=1 THEN
  294.     QuitGameFlag=0
  295.     RETURN
  296.   END IF
  297.   GOTO GamesLoop
  298. END IF
  299.  
  300. GOSUB TimeCheck
  301. GOSUB DateCheck
  302.  
  303. MCol 33
  304. MPrint cr$+cr$+cr$+"Wow, so you've played the five hands. Let's see if you made the"
  305. MPrint cr$+"Best Scores Table..."
  306. GOSUB Delay1
  307. GOSUB Delay1
  308.  
  309. flnm$=path$+"8s.scores"
  310. OPEN flnm$ FOR INPUT AS #2
  311. FOR K=1 TO 15
  312.   FOR L=1 TO 3
  313.     LINE INPUT #2, Scores$(k,l)
  314.   NEXT
  315. NEXT
  316. CLOSE #2
  317.  
  318. IF v(1) < VAL(Scores$(15,2)) THEN
  319.   MCol 36
  320.  
  321.   IF v(1)=0 THEN
  322.     MPrint cr$+cr$+"WOW! A Perfect Score!!!! Well Done. Writing the new file..."
  323.   ELSE
  324.     MPrint cr$+cr$+"WOW! You DID make it! Better save out the new file..."
  325.   END IF  
  326.   GOSUB Delay1
  327.  
  328.   Scores$(15,1)=Uname$
  329.   Scores$(15,2)=STR$(v(1))
  330.   Scores$(15,3)=Date2$
  331.  
  332.   FOR k=15 to 2 STEP -1
  333.     IF VAL(scores$(k,2))<VAL(scores$(k-1,2)) THEN
  334.       SWAP scores$(k,1),scores$(k-1,1)
  335.       SWAP scores$(k,2),scores$(k-1,2)
  336.       SWAP scores$(k,3),scores$(k-1,3)
  337.     END IF
  338.   NEXT k
  339.  
  340.   flnm$=path$+"8s.scores"
  341.   OPEN flnm$ FOR OUTPUT AS #2
  342.   FOR K=1 TO 15
  343.     FOR L=1 TO 3
  344.       PRINT #2, Scores$(K,L)
  345.     NEXT
  346.   NEXT
  347.   CLOSE #2
  348.  
  349.   IconKill$=flnm$+".info"
  350.   KILL IconKill$
  351.   GOSUB Scores
  352.  
  353. ELSE
  354.   MCol 36
  355.   MPrint cr$+cr$+"Nah, sorry, you haven't made it. Maybe next time!"
  356.   GOSUB AnyKey
  357. END IF
  358.  
  359. RETURN
  360.  
  361.  
  362. REM ******************************************************************
  363. main:
  364. REM ******************************************************************
  365.  
  366. LastCard$=" Nothing at all!"
  367. OldLastCard$=LastCard$
  368.  
  369. a=0
  370. f7=0
  371. hndno=hndno+1
  372. GOSUB ClearScreen
  373. R=52 
  374. Mcol 32
  375. MPrint cr$+"  Shuffling..."
  376.  
  377. D$="SHCD"
  378. acard$=" A 2 3 4 5 6 7 8 910 J Q K"
  379. s$="Spades  Hearts  Clubs   Diamonds"
  380. D=1
  381.  
  382. FOR i=1 TO 52 
  383.   c(i)=0
  384. NEXT i
  385. MPrint "..."
  386.  
  387. FOR p1=1 TO 8
  388.   p(p1)=6
  389. NEXT p1
  390. MPrint "..."
  391.    
  392. FOR l0=1 TO N
  393.   MPrint "..."
  394.   FOR l1=1 TO 6
  395.     GOSUB deal
  396.     c((y-1)*4+x)=l0
  397.   NEXT l1
  398. NEXT l0
  399.  
  400. MPrint cr$
  401. GOSUB showhand
  402. GOSUB deal
  403.  
  404. IF y=1 THEN a=1
  405. IF y=7 THEN f7=1
  406. MCol 35
  407. MPrint cr$+"Start --->"
  408. spk$="start .":GOSUB speak
  409.  
  410. GOSUB PrintCard
  411. spk$=MID$(acard$,y*2-1,2)+" of "+MID$(s$,x*8-7,8):GOSUB speak
  412. LastCard$=CardToPrint$
  413.  
  414. 610
  415. s1=x 
  416. s2=y
  417.  
  418. 640
  419. D=D+1
  420. q1=0
  421. q2=0
  422. IF D > N THEN D=D-N
  423. IF s2<> 1 OR a=0 THEN GOTO 730
  424. MCol 33
  425. MPrint cr$+"Hand #"+STR$(D)+":"
  426. MCol 32
  427. MPrint "   skipped."
  428. spk$="hand "+STR$(D)+" skipped.":GOSUB speak
  429. a=0
  430. GOTO 640
  431.  
  432. 730
  433. IF D=1 THEN GOTO 1270
  434. x=1 
  435.  
  436. 750
  437. y=1
  438.  
  439. 760
  440. IF c((y-1)*4+x) <> D THEN GOTO 880
  441. IF s2<>7 THEN GOTO 830
  442. IF y=7 THEN GOTO 810
  443. IF f7=0 THEN GOTO 830
  444. GOTO 880
  445.  
  446. 810
  447. f7=f7+1
  448. GOTO 960
  449.  
  450. 830
  451. IF x=s1 OR y=s2 THEN GOTO 930
  452. IF y<> 8 THEN GOTO 880
  453. q1=x
  454. q2=y
  455.  
  456. 880
  457. y=y+1
  458. IF y<=13 THEN GOTO 760
  459. x=x+1
  460. IF x<=4 THEN GOTO 750
  461. x=q1
  462. y=q2
  463. GOTO 970
  464.  
  465. 930
  466. IF y=7 THEN f7=1
  467.  
  468. 960
  469. q1=0
  470. q2=0
  471.  
  472. 970
  473. MCol 33
  474. MPrint cr$+"Hand #"+STR$(D)+": "
  475. IF x<>0 THEN GOTO 1040
  476. MCol 31
  477. MPrint "   Draws "
  478. GOSUB draw
  479. IF m>9 THEN GOTO 1020
  480. MPrint STR$(m)+" "
  481. spk$="hand "+STR$(D)+" draws "+STR$(m)+".":GOSUB speak
  482. GOTO 640
  483.  
  484. 1020
  485. MPrint STR$(m)
  486. GOTO 640
  487.  
  488. 1040
  489. spk$="hand "+STR$(D) : GOSUB speak
  490. OldLastCard$=LastCard$
  491. GOSUB PrintCard
  492. LastCard$=CardToPrint$
  493. spk$=MID$(acard$,y*2-1,2)+" of "+MID$(s$,x*8-7,8):GOSUB speak
  494.  
  495. 1050
  496. c((y-1)*4+x)=-1
  497. IF q1<>0 AND D<>1 THEN GOTO 1080
  498. IF y<>8 OR D=1 THEN GOTO 1210
  499.  
  500. 1080
  501. FOR i=1 TO 5
  502.   s(i)=0
  503. NEXT i
  504. FOR x1=1 TO 4
  505.   FOR y1=1 TO 13
  506.     IF c((y1-1)*4+x1)=D THEN s(x1)=s(x1)+1
  507.   NEXT y1
  508. NEXT x1
  509.  
  510. FOR x1=1 TO 4
  511.   IF s(x1) <= s(5) THEN GOTO 1190
  512.   s(5)=s(x1)
  513.   x=x1
  514.  
  515. 1190
  516. NEXT x1
  517.  
  518. MCol 31
  519. MPrint cr$+"    Call:    "+MID$(s$,x*8-7,8)
  520. LastCard$=LastCard$+" Called: "+MID$(s$,x*8-7,8)
  521. spk$="call " : GOSUB speak
  522. spk$="      "+MID$(s$,x*8-7,8):GOSUB speak
  523.  
  524. 1210
  525. p(D)=p(D)-1
  526. IF p(D)=0 THEN GOTO 2380
  527. IF y<> 1 THEN GOTO 610
  528. a=1
  529. GOTO 610
  530.  
  531. 1270
  532. REM input
  533.  
  534. GOSUB TimeCheck
  535. MCol 31
  536. MPrint cr$
  537. MPrint cr$+"+-----------------------------+"
  538. MPrint cr$+"| Tap a key to play your turn |"
  539. MPrint cr$+"+-----------------------------+"+cr$
  540. in%=0:il%=1:GOSUB modem.in
  541. GOSUB ClearScreen
  542. GOSUB showhand
  543. MCol 35
  544. MPrint cr$+"Your play:"
  545. spk$="your play":GOSUB speak
  546.  
  547. 1280
  548. GOSUB getinp
  549.  
  550. IF k=ASC("Z") THEN 
  551.   MCol 33
  552.   MPrint cr$+"This is hand #"+STR$(hndno)+"."
  553.   MCol 31
  554.   MPrint cr$+"Are you really sure you want to quit (y/N)? "
  555.   MCol 37
  556.   in%=3:il%=1:YES=0:GOSUB Modem.in
  557.   IF in$="YES" THEN
  558.     QuitGameFlag=1
  559.     IF CompGame=1 THEN
  560.       MCol 36
  561.       MPrint cr$+cr$+"Okay, but you aren't eligible to go into the"
  562.       MPrint cr$+"Best Scores Table for that woeful effort!"+cr$
  563.     END IF 
  564.     GOTO QuitFromGame
  565.   END IF
  566.   GOTO 1270
  567. END IF
  568.  
  569. IF k<> ASC("D") THEN GOTO 1360
  570. MCol 31
  571. MPrint "   Draws "
  572. GOSUB draw
  573. MPrint STR$(m)
  574. IF m<10 THEN MPrint " "
  575. spk$="you draw "+STR$(m):GOSUB speak
  576. GOTO 640
  577.  
  578. 1360
  579. IF k<> ASC("1") THEN GOTO 1400
  580. MCol 31
  581. MPrint cr$+"Enter '0' ONLY for a Ten."
  582. MCol 35
  583. MPrint cr$+"Try Again:"
  584. GOTO 1280
  585.  
  586. 1400
  587. l0=0
  588.  
  589. 1410
  590. l0=l0+1
  591. IF k=ASC(MID$(acard$,l0*2,1)) THEN GOTO 1670
  592. IF l0<13 THEN GOTO 1410
  593.  
  594. 1435
  595. MCol 31
  596. MPrint cr$+"Enter Card Number or Z to Quit."
  597. MCol 32
  598. MPrint cr$+"--Huh?-- :"
  599. GOTO 1280
  600.  
  601. 1670
  602. y=l0 
  603. MCol 36
  604. MPrint MID$(acard$,y*2-1,2)+" "
  605.  
  606. OldLastCard$=MID$(acard$,y*2-1,2)+" "
  607. GOSUB getinp
  608. l0=0
  609.  
  610. 1690
  611. l0=l0+1
  612. IF k= ASC(MID$(D$,l0,1)) THEN GOTO 1730
  613. IF l0<4 THEN GOTO 1690
  614. GOTO 1435
  615.  
  616. 1730
  617. x=l0
  618. MCol 36
  619. MPrint MID$(s$,x*8-7,8)
  620. OldLastCard$=OldLastCard$+MID$(s$,x*8-7,8)
  621. spk$=MID$(acard$,y*2-1,2)+" of "+MID$(s$,x*8-7,8) :GOSUB speak
  622. IF c((y-1)*4+x)=1 THEN GOTO 1790
  623. MCol 33
  624. MPrint cr$+cr$+"Play your own cards!!"+cr$
  625. spk$="that card is not in your hand." : GOSUB speak
  626. GOTO 1270
  627.  
  628. 1790
  629. IF x=s1 OR y=s2 THEN GOTO 1840
  630. IF y=8 THEN GOTO 1840
  631. Mcol 33
  632. MPrint cr$+cr$+"Follow suit or rank!!"+cr$
  633. spk$="follow sute or number" : GOSUB speak
  634. GOTO 1270
  635.  
  636. 1840
  637. IF s2=7 THEN GOTO 1980
  638. IF y=7 THEN GOTO 1990
  639.  
  640. 1880
  641. LastCard$=OldLastCard$
  642. IF y<>8 THEN GOTO 1050
  643. c((y-1)*4+x)=-1
  644. MCol 31
  645. MPrint cr$+"     Call:   "
  646. spk$="call ": GOSUB speak
  647.  
  648. 1910
  649. GOSUB getinp
  650. l0=0
  651.  
  652. 1920
  653. l0=l0+1
  654. IF k=ASC(MID$(D$,l0,1)) THEN GOTO 1960
  655. IF l0<4 THEN GOTO 1920
  656. GOTO 1910
  657.  
  658. 1960
  659. x=l0
  660. MCol 36
  661. MPrint MID$(s$,x*8-7,8)
  662. LastCard$=OldLastCard$+" Called: "+MID$(s$,x*8-7,8)
  663. spk$="      "+ MID$(s$,x*8-7,8) : GOSUB speak
  664. GOTO 1210
  665.  
  666. 1980
  667. IF y<>7 THEN 2010
  668.  
  669. 1990
  670. f7=f7+1
  671. LastCard$=OldLastCard$
  672. GOTO 1050
  673.  
  674. 2010
  675. IF f7=0 THEN GOTO 1880
  676. MCol 33
  677. MPrint cr$+cr$+"Play a '7' or Draw!!!!"+cr$
  678. spk$="Play a 7 or draw." : GOSUB speak
  679. GOTO 1270
  680.  
  681.  
  682. REM ******************************************************************
  683. PrintCard:
  684. REM ******************************************************************
  685.  
  686. MCol 36
  687. CardToPrint$=MID$(acard$,y*2-1,2)+" "+MID$(s$,x*8-7,8)
  688. MPrint CardToPrint$
  689. RETURN
  690.                          
  691.  
  692. REM ******************************************************************
  693. Draw:
  694. REM ******************************************************************
  695.  
  696. m=f7*3
  697. IF m<1 THEN m=1
  698. m1=m
  699. FOR t=1 TO m1
  700.   GOSUB deal
  701.   IF m<> m1 THEN GOTO 2160
  702.   c((y-1)*4+x)=D
  703. 2160
  704. NEXT t
  705. p(D)=p(D)+m
  706. f7=0
  707. RETURN
  708.       
  709. REM ******************************************************************
  710. Deal:
  711. REM ******************************************************************
  712.  
  713. IF R<>0 THEN GOTO 2320
  714. FOR x1=1 TO 52
  715.   IF c(x1)<>-1 THEN GOTO 2280
  716.   c(x1)=0
  717.   R=R+1
  718. 2280
  719. NEXT x1
  720.  
  721. c((s2-1)*4+s1)=-1
  722. R=R-1
  723. IF R>0 THEN GOTO 2320
  724. m=m-1
  725. RETURN
  726.    
  727. 2320
  728. x= INT(RND*4+1)
  729. z= INT(RND*4)
  730. y= INT(RND*13+1)
  731. IF c((y-1)*4+x)<>0 THEN GOTO 2320
  732. c((y-1)*4+x)=-1
  733. R=R-1
  734. RETURN
  735.  
  736.  
  737. REM ****************************************************************** 
  738. 2380
  739. REM ****************************************************************** 
  740.  
  741. MCol 33
  742. MPrint cr$+cr$+"A Winner .................................................. "+cr$
  743. spk$="a winner:":GOSUB speak
  744. MCol 35
  745. MPrint cr$+"***************************"
  746. MPrint cr$+"    Hand "+STR$(D)+" Wins!"
  747. MPrint cr$+"***************************"+cr$+cr$
  748. GOSUB AnyKey
  749. GOSUB ClearScreen
  750.  
  751. FOR z= 1 TO N
  752.   R=0
  753.   IF z=1 THEN GOTO 2450
  754.   MCol 31
  755.   MPrint cr$+cr$+"Hand #"+STR$(z)+": "+cr$
  756.   MCol 35
  757.   MPrint "-----------"
  758.   GOTO 2460
  759.  
  760. 2450
  761.   MCol 31
  762.   MPrint cr$+cr$+"Your Hand: "+cr$
  763.   MCol 35
  764.   MPrint "-----------"
  765.  
  766. 2460
  767.   FOR x=1 TO 4
  768.     FOR y=1 TO 13
  769.       IF c((y-1)*4+x) <> z THEN GOTO 2570
  770.       MPrint cr$
  771.       GOSUB PrintCard
  772.       R=R+1
  773.       IF y=1 THEN R=R+2
  774.       IF y=7 THEN R=R+9
  775.       IF y=8 THEN R=R+4
  776. 2570
  777.     NEXT y
  778.   NEXT x
  779.  
  780.   Mcol 35
  781.   MPrint cr$+"-----------"+cr$
  782.   
  783.   IF R<>1 THEN GOTO 2595
  784.   MCol 33
  785.   MPrint "  1 Point   "+cr$+cr$
  786.   GOTO 2605
  787.  
  788. 2595
  789.   IF R<10 THEN MPrint " "
  790.   MCol 33
  791.   MPrint STR$(R)+" Points  "+cr$+cr$
  792.  
  793. 2605
  794.   v(z)=v(z)+R
  795.   GOSUB AnyKey
  796. NEXT z
  797.  
  798. GOSUB ClearScreen
  799.   
  800. IF hndno=1 THEN GOTO 2680
  801. MCol 32
  802. MPrint cr$+cr$+"After"+STR$(hndno)+" hands..."
  803. GOTO 2689
  804.  
  805. 2680
  806. MCol 32
  807. MPrint cr$+cr$+"After"+STR$(hndno)+" hand..."
  808.  
  809. 2689
  810. MCol 35
  811. MPrint cr$+"----------------"
  812. FOR z=1 TO N
  813.   IF z>1 THEN GOTO 2740
  814.   MCol 31
  815.   MPrint cr$+"Your hand:"
  816.   GOTO 2745
  817.  
  818. 2740
  819.   MCol 31
  820.   MPrint cr$+"Hand #"+STR$(z)+": "
  821.  
  822. 2745
  823.   IF v(z)<100 THEN MPrint " "
  824.   IF v(z)<10 THEN MPrint " "
  825.   MCol 36
  826.   MPrint STR$(v(z))
  827. NEXT z
  828. MPrint cr$+cr$
  829.  
  830. QuitFromGame:
  831. GOSUB AnyKey
  832. RETURN  'Back to the PlaySection
  833.  
  834.  
  835. REM ****************************************************************** 
  836. Showhand:
  837. REM ******************************************************************
  838.  
  839. MCol 37
  840. MPrint cr$+"Hand:    #Cards"
  841. MCol 31
  842. MPrint cr$+"---------------"
  843.  
  844. FOR x=1 TO N 
  845.   IF x=1 THEN
  846.     MCol 32
  847.     MPrint cr$+" You    : "
  848.   ELSE
  849.     MCol 32
  850.     MPrint cr$+"Hand "+STR$(x)+" : "
  851.   END IF
  852.  
  853.   IF p(x)<10 THEN MPrint " "
  854.   MCol 36
  855.   MPrint STR$(p(x))
  856. NEXT x
  857.  
  858. MPrint cr$
  859. MCol 37
  860. MPrint cr$+" Your Hand "
  861. MCol 31
  862. MPrint cr$+"-----------"
  863.  
  864. FOR x=1 TO 4
  865.   FOR y=1 TO 13
  866.     IF c((y-1)*4+x)=1 THEN 
  867.       MPrint cr$
  868.       GOSUB PrintCard 
  869.     END IF 
  870.   NEXT y 
  871. NEXT x 
  872.  
  873. MCol 35
  874. MPrint cr$+cr$+"Last Card:"
  875. MCol 33
  876. MPrint LastCard$
  877.  
  878. 4080
  879. RETURN
  880.                                           
  881.  
  882. REM ******************************************************************
  883. Getinp:
  884. REM ******************************************************************
  885.  
  886. GOSUB TimeCheck
  887. in%=0:il%=1
  888. GOSUB modem.in
  889. k=ASC(in$)
  890. RETURN
  891.    
  892.  
  893. REM ******************************************************************
  894. Scores:
  895. REM ******************************************************************
  896.  
  897. GOSUB ClearScreen
  898. flnm$=path$+"8s.scores"
  899. OPEN flnm$ FOR INPUT AS #2
  900. FOR K=1 TO 15
  901.   FOR L=1 TO 3
  902.     LINE INPUT #2, Scores$(k,l)
  903.   NEXT
  904. NEXT
  905. CLOSE #2
  906.  
  907. MCol 35
  908. MPrint "   ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"+cr$
  909. MCol 35
  910. MPrint "   º"
  911. MCol 37
  912. MPrint "         Crazy 8s Best Scores           "
  913. MCol 35
  914. MPrint "º"+cr$
  915. MPrint "   ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"+cr$+cr$
  916.  
  917. FOR K=1 TO 15
  918.   MCol 36
  919.   Kay$=RIGHT$(STR$(k),LEN(STR$(k))-1)
  920.   Kay$="("+Kay$+")"
  921.   IF k<10 THEN Kay$=" "+Kay$
  922.   MPrint Kay$+"  "
  923.   MCol 32
  924.   MPrint Scores$(k,1)+SPACE$(26-LEN(Scores$(k,1)))
  925.   MCol 33
  926.   MPrint Scores$(k,2)+SPACE$(8-LEN(Scores$(k,2)))
  927.   MCol 31
  928.   MPrint Scores$(k,3)+cr$
  929. NEXT
  930.  
  931. GOSUB AnyKey
  932. RETURN
  933.  
  934.  
  935. REM ******************************************************************
  936. speak:
  937. REM ******************************************************************
  938.  
  939. IF ring%=0 AND TalkToMe=1 THEN
  940.  
  941.   IF MID$(spk$,7,1)="H" THEN MID$(spk$,7)="harts   "
  942.   IF MID$(spk$,7,1)="D" THEN MID$(spk$,7)="di-monds"
  943.   temp$=spk$
  944.   IF MID$(spk$,1,1)=" " AND  MID$(spk$,2,1)="A" THEN spk$="ace of "+RIGHT$(temp$,8)
  945.   IF MID$(spk$,2,1)="J" THEN spk$="jack of "+ RIGHT$(temp$,8)
  946.   IF MID$(spk$,2,1)="K" THEN spk$="king of "+ RIGHT$(temp$,8)
  947.   IF MID$(spk$,2,1)="Q" THEN spk$="queen of "+ RIGHT$(temp$,8)
  948.   IF LEFT$(spk$,1)="1" THEN spk$="ten of "+RIGHT$(temp$,8)
  949.   SAY TRANSLATE$(spk$)
  950.  
  951. END IF
  952. RETURN
  953.  
  954.  
  955.  
  956.  
  957. REM ****************************************************************** 
  958. MainTitle:
  959. REM ****************************************************************** 
  960.  
  961. ' This bit just prints out the pretty Crazy 8s letters...
  962.  
  963. MCol 35
  964. MPrint "     ÉÍÍÍÍÍÍÍÍ»                                               "
  965. MCol 37
  966. MPrint "ÉÍÍÍÍÍÍÍÍ»"+cr$
  967.  
  968. MCol 35
  969. MPrint "     º        º     "
  970. MCol 32
  971. MPrint "ÉÍÍÍÍ                                     "
  972. MCol 37
  973. MPrint "º        º"+cr$
  974.  
  975. MCol 35
  976. MPrint "     º             "
  977. MCol 32
  978. MPrint "˼                         "
  979. MCol 36
  980. MPrint "º     º        "
  981. MCol 37
  982. MPrint " º        º "+cr$
  983.  
  984. MCol 35
  985. MPrint "     º             "
  986. MCol 32
  987. MPrint "º       "
  988. MCol 31
  989. MPrint " ÍÍÍ»             "
  990. MCol 36
  991. MPrint " º     º         "
  992. MCol 37
  993. MPrint "È»      É¼"+cr$
  994.  
  995. MCol 35
  996. MPrint "     º             "
  997. MCol 32
  998. MPrint "º           "
  999. MCol 31
  1000. MPrint "º             "
  1001. MCol 36
  1002. MPrint " º     º          "
  1003. MCol 37
  1004. MPrint "ÌÍÍÍÍÍ͹"+cr$
  1005. MCol 35
  1006. MPrint "     º             "
  1007. MCol 32 
  1008. MPrint "º       "
  1009. MCol 31
  1010. MPrint "ÉÍÍ͹             "
  1011. MCol 36
  1012. MPrint " ÈÍÍÍÍ͹         "
  1013. MCol 37
  1014. MPrint "ɼ      È»"+cr$
  1015.  
  1016. MCol 35
  1017. MPrint "     º                     "
  1018. MCol 31
  1019. MPrint "º   º   "
  1020. MCol 33
  1021. MPrint " ÍÍÍÍÍ»          "
  1022. MCol 36
  1023. MPrint "º         "
  1024. MCol 37
  1025. MPrint "º        º  "
  1026. MCol 34
  1027. MPrint "ÉÍÍ"+cr$
  1028.  
  1029. MCol 35
  1030. MPrint "     º        º            "
  1031. MCol 31
  1032. MPrint "ÈÍÍÍÊ        "
  1033. MCol 33
  1034. MPrint "ɼ          "
  1035. MCol 36
  1036. MPrint "º         "
  1037. MCol 37
  1038. MPrint "º        º  "
  1039. MCol 34
  1040. MPrint "ÈÍ»"+cr$
  1041.  
  1042. MCol 35
  1043. MPrint "     ÈÍÍÍÍÍÍÍͼ                      "
  1044. MCol 33
  1045. MPrint "ÉÍͼ     "
  1046. Mcol 36
  1047. MPrint " ÍÍÍÍͼ         "
  1048. MCol 37
  1049. MPrint "ÈÍÍÍÍÍÍÍͼ  "
  1050. MCol 34
  1051. MPrint "Íͼ"+cr$
  1052. MCol 33
  1053. MPrint "                                    É¼"+cr$
  1054. MPrint "                                    ÈÍÍÍÍÍ"+cr$+cr$
  1055.  
  1056. RETURN
  1057.  
  1058.  
  1059. REM ****************************************************************** 
  1060. Instruct:
  1061. REM ****************************************************************** 
  1062.  
  1063. GOSUB InstructHeader
  1064. MCol 35
  1065. MPrint cr$+"  If you have played the commercial game 'UNO' before, you will have some"
  1066. MPrint cr$+"  idea of how this game works. It is played with a standard 52-card deck, and"
  1067. MPrint cr$+"  players take it in turns to lead a card, with the object of getting rid of"
  1068. MPrint cr$+"  all their cards."+cr$
  1069. MCol 36
  1070. MPrint cr$+"  A lead is based on the last card played. You must follow either the suit"
  1071. MPrint cr$+"  of the last card or the number. (EG if the last card was the 3 Diamonds, a"
  1072. MPrint cr$+"  a legal play is any Diamond or any 3)."+cr$
  1073. MCol 33
  1074. MPrint cr$+"  There are several special cards, however. If a 7 is played, the next player"
  1075. MPrint cr$+"  MUST play another 7, or draw 3 cards. (If the next player CAN play a 7,"
  1076. MPrint cr$+"  then the next player after that must play a 7 or draw 6 cards - the amount"
  1077. MPrint cr$+"  of cards to be drawn is cumulative)."+cr$
  1078. MCol 31
  1079. MPrint cr$+"  An 8 is 'CRAZY' and can be played AT ANY TIME (except where a 7 is needed)"
  1080. MPrint cr$+"  Playing an 8 also allows you to call the suit that the next lead will be"
  1081. MPrint cr$+"  played in. You can make the suit anything you want."+cr$
  1082. GOSUB AnyKey
  1083. GOSUB InstructHeader
  1084. MCol 35
  1085. MPrint cr$+"  If an Ace is played, the next player's turn will be skipped."+cr$
  1086. MCol 36
  1087. MPrint cr$+"  If you don't have a legal play, you must draw from the deck. To do this,"
  1088. MPrint cr$+"  press 'D' for Draw."+cr$
  1089. MCol 33
  1090. MPrint cr$+"  Enter your moves by pressing the NUMBER of the card you wish to play,"
  1091. MPrint cr$+"  followed by the first letter of the suit. To enter a 10, use the '0' key"
  1092. MPrint cr$+"  ONLY. To enter an Ace, Jack, Queen or King, enter A, J, Q or K."+cr$
  1093. MCol 31
  1094. MPrint cr$+"  All keypresses are hot-keyed, so there is no need to press <return> after"
  1095. MPrint cr$+"  entering the figures. If you wish to change your mind halfway through"
  1096. MPrint cr$+"  entering a card, input a nonsensical value for the suit (eg 'L' or 'X')."+cr$
  1097. Mcol 35
  1098. MPrint cr$+"  You can quit the game by entering a 'Z' as the number of the card to play."+cr$
  1099. GOSUB AnyKey
  1100. GOSUB InstructHeader
  1101. MCol 36
  1102. MPrint cr$+"  There are now two types of gameplay possible: Competition and Practice."
  1103. MPrint cr$+"  In the Competition section, you must play 5 complete hands against 3"
  1104. MPrint cr$+"  opponents, and your scores are eligible for the Best Scores Table. If you"
  1105. MPrint cr$+"  quit before completing either the hand, or the 5 hands, you will NOT be"
  1106. MPrint cr$+"  eligible for the Best Scores table at all."+cr$
  1107. MCol 33
  1108. MPrint cr$+"  In the Practice section, you can play between 1 and 3 opponents, but your"
  1109. MPrint cr$+"  scores will not count anywhere except between you and the computer!"+cr$
  1110. MCol 31
  1111. MPrint cr$+"  At the end of each round, your remaining cards are totalled and you score"
  1112. MPrint cr$+"  penalty points for them. A 7 is worth 10 points, an 8 worth 5, an Ace is"
  1113. MPrint cr$+"  worth 3, and all the others are worth 1 point each."+cr$
  1114. MCol 35
  1115. MPrint cr$+"  Naturally, the LOWER your score, the better you are going to do on the"
  1116. MPrint cr$+"  Best Scores Table."+cr$
  1117. GOSUB AnyKey
  1118. RETURN
  1119.  
  1120. REM ****************************************************************** 
  1121. InstructHeader:
  1122. REM ****************************************************************** 
  1123.  
  1124. GOSUB ClearScreen
  1125. MCol 32
  1126. MPrint "  ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"+cr$
  1127. MCol 32
  1128. MPrint "  º   "
  1129. MCol 31
  1130. MPrint "C  "
  1131. MCol 32
  1132. MPrint "r  "
  1133. MCol 31
  1134. MPrint "a  "
  1135. MCol 34
  1136. MPrint "z  "
  1137. MCol 35
  1138. MPrint "y      "
  1139. MCol 37
  1140. MPrint "8  "
  1141. MCol 36
  1142. MPrint "s      "
  1143. MCol 31
  1144. MPrint "I  "
  1145. MCol 32
  1146. MPrint "n  "
  1147. MCol 33
  1148. MPrint "s  "
  1149. MCol 34
  1150. MPrint "t  "
  1151. MCol 35
  1152. MPrint "r  "
  1153. MCol 36
  1154. MPrint "u  "
  1155. MCol 37
  1156. MPrint "c  "
  1157. MCol 31
  1158. MPrint "t  "
  1159. MCol 32
  1160. MPrint "i  "
  1161. MCol 33
  1162. MPrint "o  "
  1163. MCol 34
  1164. MPrint "n  "
  1165. MCol 35
  1166. MPrint "s   "
  1167. MCol 32
  1168. MPrint " º"+cr$
  1169. MCol 32
  1170. MPrint "  ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ "+cr$
  1171. RETURN
  1172.  
  1173.  
  1174. REM ****************************************************************** 
  1175. MenuPrint:
  1176. REM ****************************************************************** 
  1177.  
  1178. GOSUB ClearScreen
  1179.  
  1180. GOSUB CheckHotKey
  1181. IF GotOne=1 THEN GOTO MenuPrintBack
  1182.  
  1183. MCol 34
  1184. MPrint "     ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»"+cr$
  1185.  
  1186. GOSUB CheckHotKey
  1187. IF GotOne=1 THEN GOTO MenuPrintBack
  1188.  
  1189. MCol 34
  1190. MPrint "     º               "
  1191. MCol 31
  1192. MPrint "C  "
  1193. MCol 33
  1194. MPrint "r  "
  1195. MCol 32
  1196. MPrint "a  "
  1197. MCol 35
  1198. MPrint "z  "
  1199. MCol 36
  1200. MPrint "y    "    
  1201. MCol 37
  1202. MPrint "8  "
  1203. MCol 31
  1204. MPrint "s     "
  1205. MCol 33
  1206. MPrint "M  "
  1207. MCol 32
  1208. MPrint "E  "
  1209. MCol 35
  1210. MPrint "N  "
  1211. MCol 36
  1212. MPrint "U               "
  1213. MCol 34
  1214. MPrint "º "
  1215. MCol 32
  1216. MPrint "²²"+cr$
  1217.  
  1218. GOSUB CheckHotKey
  1219. IF GotOne=1 THEN GOTO MenuPrintBack
  1220.  
  1221. MCol 32
  1222. MPrint "     "
  1223. MCol 34
  1224. MPrint "ÇÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĶ "
  1225. MCol 32
  1226. MPrint "²²"+cr$
  1227.  
  1228. GOSUB CheckHotKey
  1229. IF GotOne=1 THEN GOTO MenuPrintBack
  1230.  
  1231. MCol 34
  1232. MPrint "     "
  1233. MPrint "º                                                                  º "
  1234. MCol 32
  1235. MPrint "²²"+cr$
  1236.  
  1237. GOSUB CheckHotKey
  1238. IF GotOne=1 THEN GOTO MenuPrintBack
  1239.  
  1240. MCol 32
  1241. MPrint "     "
  1242. MCol 34
  1243. MPrint "º      "
  1244. MCol 31
  1245. MPrint "<"
  1246. MCol 32
  1247. MPrint "P"
  1248. MCol 31
  1249. MPrint ">"
  1250. MCol 32
  1251. MPrint "lay a Game   "
  1252. MCol 35
  1253. MPrint "Play either a Competition or Practice Game. "
  1254. MCol 34
  1255. MPrint "º "
  1256. MCol 32
  1257. MPrint "²²"+cr$
  1258.  
  1259. GOSUB CheckHotKey
  1260. IF GotOne=1 THEN GOTO MenuPrintBack
  1261.  
  1262. MCol 34
  1263. MPrint "     "
  1264. MPrint "º      "
  1265. MCol 31
  1266. MPrint "<"
  1267. MCol 32
  1268. MPrint "A"
  1269. MCol 31
  1270. MPrint ">"
  1271. MCol 32
  1272. MPrint "bout         "
  1273. MCol 35
  1274. MPrint "In true Amiga form, prints useless info.    "
  1275. MCol 34
  1276. MPrint "º "
  1277. MCol 32
  1278. MPrint "²²"+cr$
  1279.  
  1280. GOSUB CheckHotKey
  1281. IF GotOne=1 THEN GOTO MenuPrintBack
  1282.  
  1283. MCol 34
  1284. MPrint "     º      "
  1285. MCol 31
  1286. MPrint "<"
  1287. MCol 32
  1288. MPrint "I"
  1289. MCol 31
  1290. MPrint ">"
  1291. MCol 32
  1292. MPrint "nstructions  "
  1293. MCol 35
  1294. MPrint "How to play the game (well, mostly).        "
  1295. MCol 34
  1296. MPrint "º "
  1297. MCol 32
  1298. MPrint "²²"+cr$
  1299.  
  1300. GOSUB CheckHotKey
  1301. IF GotOne=1 THEN GOTO MenuPrintBack
  1302.  
  1303. MCol 34
  1304. MPrint "     º      "
  1305. MCol 31
  1306. MPrint "<"
  1307. MCol 32
  1308. MPrint "S"
  1309. MCol 31
  1310. MPrint ">"
  1311. MCol 32
  1312. MPrint "cores        "
  1313. MCol 35
  1314. MPrint "Best scorers - 5 games against 3 opponents. "
  1315. MCol 34
  1316. MPrint "º "
  1317. MCol 32
  1318. MPrint "²²"+cr$
  1319.  
  1320. GOSUB CheckHotKey
  1321. IF GotOne=1 THEN GOTO MenuPrintBack
  1322.  
  1323. MCol 34
  1324. MPrint "     º      "
  1325. MCol 31
  1326. MPrint "<"
  1327. MCol 32
  1328. MPrint "Q"
  1329. MCol 31
  1330. MPrint ">"
  1331. MCol 32
  1332. MPrint "uit          "
  1333. MCol 35
  1334. MPrint "Okay, Okay, I can take a hint.              "
  1335. MCol 34
  1336. MPrint "º "
  1337. MCol 32
  1338. MPrint "²²"+cr$
  1339.  
  1340. GOSUB CheckHotKey
  1341. IF GotOne=1 THEN GOTO MenuPrintBack
  1342.  
  1343. MCol 34
  1344. MPrint "     º      "
  1345. MCol 31
  1346. MPrint "<"
  1347. MCol 32
  1348. MPrint "?"
  1349. MCol 31
  1350. MPrint ">"
  1351. MCol 32
  1352. MPrint "=Menu        "
  1353. MCol 35
  1354. MPrint "Print this very screen up.                  "
  1355. MCol 34
  1356. MPrint "º "
  1357. MCol 32
  1358. MPrint "²²"+cr$
  1359.  
  1360. GOSUB CheckHotKey
  1361. IF GotOne=1 THEN GOTO MenuPrintBack
  1362.  
  1363. MCol 34
  1364. MPrint "     º                                                                  º "
  1365. MCol 32
  1366. MPrint "²²"+cr$
  1367.  
  1368. GOSUB CheckHotKey
  1369. IF GotOne=1 THEN GOTO MenuPrintBack
  1370.  
  1371. MCol 34
  1372. MPrint "     ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ"
  1373. MCol 32
  1374. MPrint " ²²"+cr$
  1375.  
  1376. GOSUB CheckHotKey
  1377. IF GotOne=1 THEN GOTO MenuPrintBack
  1378.  
  1379. MCol 32
  1380. MPrint "       ²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²²"+cr$+cr$
  1381.  
  1382. MenuPrintBack:
  1383.  
  1384. IF GotOne=0 THEN RETURN ELSE RETURN CommandBranch
  1385.  
  1386.  
  1387.  
  1388. REM ****************************************************************** 
  1389. About:
  1390. REM ****************************************************************** 
  1391.  
  1392. GOSUB ClearScreen
  1393. GOSUB MainTitle
  1394.  
  1395. MPrint cr$
  1396. Mcol 33
  1397. MPrint "           Original AmigaBASIC Author Unknown"+cr$+cr$
  1398. MPrint "                  "
  1399. Mcol 31
  1400. MPrint "Converted to a Metro Door by "
  1401. Mcol 35
  1402. MPrint "Peter Deane"+cr$+cr$
  1403. MPrint "                            "
  1404. Mcol 32
  1405. MPrint "Inquestor BBS, NSW, "
  1406. Mcol 34
  1407. MPrint "Australia "
  1408. Mcol 33
  1409. MPrint "(011-61-49-72-1647)"+cr$+cr$
  1410.  
  1411. GOSUB AnyKey
  1412. GOSUB ClearScreen
  1413. RETURN
  1414.  
  1415.  
  1416. REM ******************************************************************
  1417. Speakcheck:
  1418. REM ******************************************************************
  1419.  
  1420. IF ring%=0 THEN
  1421.   GOSUB ClearScreen
  1422.   MCol 34
  1423.   MPrint cr$+cr$+"(Available on the local console only)"
  1424.   MCol 35
  1425.   MPrint cr$+cr$+"Do you want me to talk to you (y/N)? "
  1426.   in%=3:il%=1:yes=0
  1427.   GOSUB modem.in
  1428.   TalkToMe=0
  1429.   IF in$="YES" THEN TalkToMe=1
  1430. END IF
  1431.  
  1432.  'forget it if a remote call...
  1433.  
  1434. RETURN 
  1435.  
  1436.  
  1437. REM ******************************************************************
  1438. Woops:
  1439. REM ******************************************************************
  1440.  
  1441. Matt 0
  1442.  
  1443. IF ERR<>99 THEN
  1444.  Mprint cr$+cr$+"Oh Dear! We have had a fatal error occur."
  1445.  Mprint cr$+cr$+"The Error Number was:- "+STR$(ERR)
  1446.  IF ERR=53 THEN
  1447.    MPrint cr$+cr$+"This was a File-Not-Found error. This file SHOULD have been"
  1448.    MPrint cr$+"available to the program, and was '"+flnm$+"'"
  1449.  END IF 
  1450.  Mprint cr$+"There will be a note made of this for the sysop, but please"
  1451.  Mprint cr$+"remind him by leaving him a message and let him know"
  1452.  Mprint cr$+"what you were doing just before the crash."
  1453.  GOSUB AnyKey
  1454. END IF
  1455.  
  1456. errflnm$=path$+"Crazy8s.errors!"
  1457. OPEN errflnm$ FOR APPEND AS # 65
  1458. PRINT #65, ""
  1459. PRINT #65, "Fatal Error Occured At ";TIME$;" on ";DATE$
  1460. PRINT #65, "Error #";STR$(ERR);" Last Line #";STR$(ERL)
  1461. PRINT #65, ""
  1462. IF ERR=99 THEN
  1463.   PRINT #65, UName$; " dropped carrier."
  1464.   PRINT #65, ""
  1465. END IF
  1466. IF ERR=53 THEN
  1467.   PRINT #65, "File Not Found. Looking for: ";flnm$
  1468.   PRINT #65, ""
  1469. END IF
  1470. CLOSE #65
  1471. GOTO Bye
  1472.  
  1473.  
  1474. REM ******************************************************************
  1475. FinishUp:
  1476. REM ******************************************************************
  1477.  
  1478. GOSUB ClearScreen
  1479.  
  1480. MCol 31
  1481. MPrint "                   G  O  O  D  B  Y  E         F  R  O  M :"+cr$+cr$
  1482.  
  1483. GOSUB MainTitle
  1484.  
  1485. Mcol 33
  1486. MPrint cr$+"If you like this door, then leave a message to your Sysop asking"+cr$
  1487. MPrint "him to support the shareware concept and REGISTER the program soon."+cr$
  1488. GOSUB Delay1
  1489. GOSUB Delay1
  1490. Mcol 36
  1491. Mprint cr$+"The Crazy 8s Door was written by Peter Deane"+cr$
  1492. MPrint "Inquestor BBS, Newcastle, NSW, Australia"+cr$+cr$
  1493. Mcol 31
  1494. MPrint "011-61-49-72-1647 from the USA   (049) 72-1647 from Australia"+cr$
  1495. GOSUB Delay1
  1496. GOSUB Delay1
  1497. GOTO Bye
  1498.  
  1499.  
  1500. REM ******************************************************************
  1501. Bye:
  1502. REM ******************************************************************
  1503.  
  1504. Matt 0
  1505. Mprint cr$+cr$+"Hope to see you back soon!"
  1506. WINDOW CLOSE 1
  1507. IF Testit$<>"YES" THEN
  1508.   KILL "RAM:USERDATA"
  1509. END IF
  1510. IF ring%=1 THEN TIMER OFF
  1511. CLOSE#1
  1512. LIBRARY CLOSE
  1513. END
  1514.  
  1515.  
  1516.  
  1517. '--------------- PARAMETER SETTNGS
  1518.  
  1519.  
  1520. REM ******************************************************************
  1521. SetAnsi:
  1522. REM ******************************************************************
  1523.  
  1524. Matt 0
  1525. Mprint cr$+cr$+"Do you want ANSI colours (Y/n)? "
  1526. in%=3:il%=1:yes=1:GOSUB modem.in
  1527.  
  1528. IF in$="YES" THEN
  1529.   ansi%=1
  1530.   Mcolour 35,40
  1531.   Mprint cr$+cr$+"ANSI now "
  1532.   MColour 31,40
  1533.   MPrint "ON!"+cr$
  1534. ELSE 
  1535.   ansi%=0
  1536.   Mprint cr$+cr$+"ANSI now OFF!"
  1537. END IF
  1538. RETURN
  1539.  
  1540.  
  1541. '--------------- MISC USEFUL FUNCTIONS
  1542.  
  1543. REM ******************************************************************
  1544. AnyKey:
  1545. REM ******************************************************************
  1546.  
  1547. Matt 0
  1548. Mprint cr$+"Tap Any Key To Continue..."
  1549. GOSUB TimeCheck
  1550. in%=0:il%=1
  1551. GOSUB Modem.in
  1552. RETURN
  1553.  
  1554.  
  1555. REM ******************************************************************
  1556. ClearScreen:
  1557. REM ******************************************************************    
  1558.                                                   
  1559. GOSUB TimeCheck
  1560.  Mprint cr$+cr$+CHR$(12)
  1561.  'Just in case the chr$(12) doesn't work, a few crs
  1562.  CLS
  1563.  Matt 0
  1564. RETURN
  1565.  
  1566.  
  1567. '--------------- The Metro Clock!
  1568.  
  1569.  
  1570. REM ******************************************************************
  1571. TimeCheck:
  1572. REM ******************************************************************
  1573.  
  1574. time1$=TIME$
  1575. t.t=VAL(LEFT$(time1$,2))
  1576.  
  1577. IF t.t>11 THEN a$=" PM"
  1578. IF t.t<12 THEN a$=" AM"
  1579. IF t.t=0 THEN
  1580.   t.t=12
  1581.   time1$=RIGHT$(STR$(t.t),2)+RIGHT$(time1$,6)
  1582. ELSEIF t.t<10 THEN
  1583.   time1$=RIGHT$(STR$(t.t),1)+RIGHT$(time1$,6)
  1584. ELSEIF t.t>21 THEN
  1585.   t.t=t.t-12
  1586.   time1$=RIGHT$(STR$(t.t),2)+RIGHT$(time1$,6)
  1587. ELSEIF t.t>12 THEN 
  1588.   t.t=t.t-12
  1589.   time1$=RIGHT$(STR$(t.t),1)+RIGHT$(time1$,6)
  1590. END IF
  1591. Time2$=time1$+a$
  1592.  
  1593. IF Rtime% >0 THEN 
  1594.   RETURN
  1595. ELSE
  1596.   Mprint cr$+cr$+"Sorry, Time Limit Exceeded!"
  1597.   GOTO Bye
  1598. END IF
  1599.  
  1600. REM ******************************************************************
  1601. delay1:
  1602. REM ******************************************************************
  1603. pause&=TIMER
  1604. WHILE TIMER<pause&+1
  1605. WEND
  1606. RETURN
  1607.  
  1608.  
  1609. REM ******************************************************************
  1610. DateCheck:
  1611. REM ******************************************************************
  1612.  
  1613. 'Should call this with GOSUB TimeCheck, GOSUB DateCheck
  1614. 'Then the strings Time2$ and Date2$ will be the ones to use in the prog
  1615.  
  1616. temp$=DATE$
  1617. DateTemp1$=MID$(temp$,4,2)
  1618. DateTemp3$=RIGHT$(temp$,2)
  1619. month%=VAL(LEFT$(temp$,2))
  1620. IF month%=1 THEN month$="Jan"
  1621. IF month%=2 THEN month$="Feb"
  1622. IF month%=3 THEN month$="Mar"
  1623. IF month%=4 THEN month$="Apr"
  1624. IF month%=5 THEN month$="May"
  1625. IF month%=6 THEN month$="Jun"
  1626. IF month%=7 THEN month$="Jul"
  1627. IF month%=8 THEN month$="Aug"
  1628. IF month%=9 THEN month$="Sep"
  1629. IF month%=10 THEN month$="Oct"
  1630. IF month%=11 THEN month$="Nov"
  1631. IF month%=12 THEN month$="Dec"
  1632. Date2$=DateTemp1$+"-"+month$+"-"+DateTemp3$
  1633. RETURN
  1634.  
  1635.  
  1636. REM ******************************************************************
  1637. RtimeDec:
  1638. REM ******************************************************************
  1639. Rtime% = RTime%-1
  1640. RETURN
  1641.  
  1642.  
  1643. '--------------- Modem receiving
  1644.  
  1645.  
  1646. REM ******************************************************************
  1647. Modem.in:
  1648. REM ******************************************************************
  1649.  
  1650. idle&=TIMER
  1651. key$=""
  1652. in$=""
  1653. a$=""
  1654. a=0
  1655. b=0
  1656. keyy=0
  1657.  
  1658. WHILE keyy<>1
  1659.  
  1660.   a$=INKEY$
  1661.   key$=a$
  1662.   a=ASC(a$)
  1663.  
  1664. 'remote caller online and no local key pressed - local always overides remote
  1665.  
  1666.   IF ring%=1 AND a=0 THEN
  1667.     cd=PEEKL(12570624&)
  1668.     cd=cd AND 8192
  1669.     IF cd<>0 THEN ERROR 99
  1670.     IF LOC(1)>0 THEN
  1671.       a$=INPUT$(1,1)
  1672.       key$=a$
  1673.       a=ASC(a$)
  1674.     END IF
  1675.   END IF
  1676.  
  1677.   IF a=0 THEN mod.in2
  1678.  
  1679.   IF a=13 THEN 
  1680.     keyy=1
  1681.   ELSE
  1682.     b=LEN(in$)
  1683.     IF (a=8 OR a=127) AND b>0 THEN
  1684.       b=b-1
  1685.       in$=LEFT$(in$,b)
  1686.       Mprint de$
  1687.     END IF
  1688.     IF b=il% THEN mod.in2
  1689.  
  1690.   'Single Uppercase Hotkey
  1691.     IF in%=0 THEN
  1692.       IF a>31 AND a<127 THEN
  1693.         key$=UCASE$(key$)
  1694.         in$=key$
  1695.         keyy=1
  1696.       END IF
  1697.     END IF
  1698.  
  1699.   END IF  '(of a=13)
  1700.  
  1701. 'Upper & Lower case
  1702.   IF in%=1 AND a>31 AND a<127 THEN
  1703.     Mprint key$
  1704.     in$=in$+key$
  1705.   END IF
  1706.  
  1707. 'UPPERCASE only
  1708.   IF in%=2 AND a>31 AND a<127 THEN
  1709.    key$=UCASE$(key$)
  1710.    Mprint key$
  1711.    in$=in$+key$
  1712.   END IF
  1713.  
  1714. 'YES/NO normal response (Percy's)
  1715.   IF in%=3 THEN
  1716.     IF a=13 AND YES=1 THEN
  1717.       Mprint "YES"+cr$
  1718.       in$="YES"
  1719.       keyy=1
  1720.     END IF
  1721.     IF a=13 AND YES=0 THEN
  1722.       Mprint "NO"+cr$
  1723.       in$="NO"
  1724.       keyy=1
  1725.     END IF
  1726.     IF a=89 OR a=121 THEN
  1727.       Mprint "YES"+cr$
  1728.       in$="YES"
  1729.       keyy=1
  1730.     END IF
  1731.     IF a=78 OR a=110 THEN
  1732.       Mprint "NO"+cr$
  1733.       in$="NO"
  1734.       keyy=1
  1735.     END IF
  1736.   END IF
  1737.  
  1738. 'Number Input only
  1739.   IF in%=4 THEN
  1740.     IF a>47 AND a<58 THEN
  1741.       Mprint key$
  1742.       in$=in$+key$
  1743.     END IF
  1744.   END IF
  1745.  
  1746. ' add more in%=xxxx here....
  1747.  
  1748. mod.in2:
  1749.  
  1750. ' Check idle timer (10 mins lev 8/9, 5 mins others)
  1751.   IF TIMER>idle&+300 THEN
  1752.     IF lev%>7 AND TIMER>idle&+600 THEN Bye
  1753.     IF lev%<8 THEN Bye
  1754.   END IF
  1755.  
  1756. mod.in2.0:
  1757. WEND  'Back up to about 5 lines below Modem.in:
  1758.  
  1759.  
  1760. 'Get rid of old keystrokes
  1761. IF ring%=1 THEN
  1762.   WHILE LOC(1)>0
  1763.     a$=INPUT$(1,1)
  1764.   WEND
  1765. END IF
  1766.  
  1767. a$=INKEY$
  1768. a$=INKEY$
  1769. a$=INKEY$
  1770.  
  1771. mod.in2.1:
  1772. RETURN
  1773.  
  1774.  
  1775. REM ******************************************************************
  1776. CheckHotKey:
  1777. REM ******************************************************************
  1778.  
  1779. GotOne=0
  1780. Keyin$=INKEY$
  1781. a=asc(keyin$)
  1782. IF a=0 AND ring%=1 THEN
  1783.   cd=PEEKL(12570624&)
  1784.   cd=cd AND 8192
  1785.   IF cd<>0 THEN Error 99
  1786.   IF LOC(1)>0 THEN Keyin$=INPUT$(1,1)
  1787. END IF
  1788.  
  1789. IF Keyin$="" THEN RETURN
  1790. Keyin$=UCASE$(Keyin$)
  1791. a=ASC(Keyin$)
  1792.  
  1793. IF a=80 THEN GotOne=1:in$="P":RETURN
  1794. IF a=73 THEN GotOne=1:in$="I":RETURN
  1795. IF a=65 THEN GotOne=1:in$="A":RETURN
  1796. IF a=81 THEN GotOne=1:in$="Q":RETURN
  1797. IF a=83 THEN GotOne=1:in$="S":RETURN
  1798.  
  1799. RETURN
  1800.  
  1801.  
  1802. '--------------- SUB PROGRAMS
  1803.  
  1804.  
  1805. REM ******************************************************************
  1806. SUB Matt (attrib%) STATIC
  1807. REM ******************************************************************
  1808. 'All mine - sets an ANSI attribute over modem, and locally for the
  1809. 'Bold, Italics, Underlined and Reset. No combo's as of yet.
  1810.  
  1811. SHARED ring%
  1812.  
  1813. IF attrib%>4 THEN EXIT SUB
  1814. IF attrib%=2 THEN EXIT SUB
  1815.  
  1816. IF ring%=1 THEN
  1817.   att$=STR$(attrib%)
  1818.   att$=RIGHT$(att$, LEN(att$)-1)
  1819.   PRINT #1, CHR$(27);"[";att$;"m";
  1820. END IF
  1821.  
  1822. IF attrib%=0 THEN  ' reset
  1823.   COLOR 7,0
  1824.   CALL SetSoftStyle(WINDOW(8),0,255)
  1825. END IF
  1826. IF attrib%=1 THEN  'Bold
  1827.   CALL SetSoftStyle(WINDOW(8),2,255)
  1828. END IF
  1829. IF attrib%=3 THEN  'italics
  1830.   CALL SetSoftStyle(WINDOW(8),4,255)
  1831. END IF
  1832. IF attrib%=4 THEN  'underlined
  1833.   CALL SetSoftStyle(WINDOW(8),1,255)
  1834. END IF
  1835. END SUB
  1836.  
  1837.  
  1838.  
  1839. REM ******************************************************************
  1840. SUB MCol (an%) STATIC  'from CJ's door sorta! Well...
  1841. REM ******************************************************************
  1842. 'Usage: MCol fgcolour
  1843. 'Just to set the main colour on black (or same background as before, anyway)
  1844.  
  1845. SHARED ring% , ansi%
  1846.  
  1847. IF ring%=1 AND ansi%=1 THEN
  1848.   an$=STR$(an%)
  1849.   an$=RIGHT$(an$, LEN(an$)-1)
  1850.   PRINT #1, CHR$(27);"[";an$;"m";
  1851. END IF
  1852. IF ansi%=1 THEN COLOR (an%-30)
  1853. END SUB
  1854.  
  1855. REM ******************************************************************
  1856. REM These Subs based on those in Craig Jackson's Wall Door. Thanks!
  1857. REM ******************************************************************
  1858.  
  1859. SUB Mprint  (out$) STATIC
  1860.     REM -- Outputs a string to screen & modem (if remote call)
  1861.  
  1862.     SHARED ring%
  1863.  
  1864.     IF ring%=1 THEN
  1865.       PRINT #1, out$;
  1866.     END IF
  1867.     PRINT out$;
  1868. END SUB
  1869.  
  1870. SUB MColour (mf%,mb%) STATIC
  1871.     REM -- Usage: MColour foregroundcolor, backgroundcolor
  1872.     REM -- Changes ANSI Over The Modem For User & Locally
  1873.  
  1874.     SHARED ring% , ansi%
  1875.  
  1876.     IF ring%=1 AND ansi%=1 THEN
  1877.         mf$=STR$(mf%)
  1878.         mb$=STR$(mb%)
  1879.         mb$=RIGHT$(mb$, LEN(mb$)-1)
  1880.         mf$=RIGHT$(mf$, LEN(mf$)-1)
  1881.         PRINT #1, CHR$(27);"[";mf$;";";mb$;"m";
  1882.     END IF
  1883.     IF ansi%=1 THEN COLOR (mf%-30),(mb%-40)
  1884. END SUB
  1885.  
  1886. SUB Mlocate (mx%,my%) STATIC
  1887.     REM -- Usage: MLocate ypos, xpos
  1888.     REM -- Changes ANSI Cursor Position Over Modem & Locally
  1889.  
  1890.     SHARED ring%
  1891.  
  1892.     IF ring%=1 THEN
  1893.         mx$=STR$(mx%)
  1894.         my$=STR$(my%)
  1895.         mx$=RIGHT$(mx$,LEN(mx$)-1)
  1896.         my$=RIGHT$(my$,LEN(my$)-1)
  1897.         PRINT #1, CHR$(27);"[";mx$;";";my$;"H";
  1898.     END IF
  1899.     LOCATE mx%,my%
  1900. END SUB
  1901.